home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / web / clip / unix / ex01_a.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-16  |  4.0 KB  |  103 lines
  1.     (***************  #file "palindrome.pas"  ***********************)
  2.     (****************************************************************)
  3.     (* Program: Palindrome filter program.                          *)
  4.     (* Purpose: To filter the palindromic lines from a given input  *)
  5.     (*          file to a specified output file.                    *)
  6.     (****************************************************************)
  7.     PROGRAM PALINDROME (INPUT, OUTPUT, IN_FILE, OUT_FILE);
  8.  
  9.     CONST
  10.         MAX_L = 132;
  11.     TYPE
  12.         ABSTRACT  = (DEFINED, UNDEFINED);
  13.         TEXT_LINE =     RECORD
  14.                             CHARS: ARRAY[1..MAX_L] OF CHAR;
  15.                             LENGTH: 0..MAX_L;
  16.                         END (*RECORD*);
  17.     VAR
  18.         IN_FILE, OUT_FILE: TEXT;
  19.         IN_LINE,
  20.         LETTERS:        TEXT_LINE;
  21.         IS_PALINDROME:  BOOLEAN;
  22.         IN_CHAR:    CHAR;
  23.         I:          INTEGER;
  24.         J:          INTEGER;
  25.  
  26.     BEGIN
  27.         OPEN (IN_FILE,  'TESTDATA.IN',  'old');     RESET   (IN_FILE);
  28.         OPEN (OUT_FILE, 'TESTDATA.OUT', 'unknown'); REWRITE (OUT_FILE);
  29.  
  30.         (*****************  Palindrome (body)  **********************)
  31.         (** Copy the lines of the IN_FILE that are palindromic to  **)
  32.         (** the OUT_FILE.                                          **)
  33.         WHILE NOT EOF (IN_FILE) DO
  34.         BEGIN
  35.             (*****************  Palindrome (1)  *********************)
  36.             (** Read a line from IN_FILE into IN_LINE. The letters **)
  37.             (** of this line are copied to LETTERS.                **)
  38.             IN_LINE.LENGTH := 0;
  39.             LETTERS.LENGTH := 0;
  40.             WITH IN_LINE DO
  41.             WHILE NOT EOLN (IN_FILE) DO
  42.             BEGIN
  43.                 READ (IN_FILE, IN_CHAR);
  44.                 LENGTH := LENGTH + 1;
  45.                 CHARS[LENGTH] := IN_CHAR;
  46.                 IF IN_CHAR IN ['A'..'Z', 'a'..'z'] THEN
  47.                 WITH LETTERS DO
  48.                 BEGIN
  49.                     LENGTH := LENGTH + 1;
  50.                     CHARS[LENGTH] := IN_CHAR;
  51.                 END (*WITH/IF*);
  52.             END (*WHILE/WITH*);
  53.  
  54.             (*********************  Palindrome (test)  **************)
  55.             (** Check contents of IN_LINE and LETTERS.  #optional  **)
  56.             (********************************************************)
  57.  
  58.             (*****************  End of Palindrome (1)  **************)
  59.  
  60.             READLN (IN_FILE);
  61.  
  62.             (*****************  Palindrome (2)  *********************)
  63.             (** Test palindromicity of LETTERS. Set IS_PALINDROME  **)
  64.             (** to reflect the result of the test.                 **)
  65.             WITH LETTERS DO
  66.             BEGIN
  67.                 (* Transform lowercase to uppercase.                *)
  68.                 FOR I := 1 TO LENGTH DO
  69.                 IF CHARS[I] IN ['a'..'z']
  70.                 THEN CHARS[I] :=
  71.                      CHR(ORD(CHARS[I]) - ORD('a') + ORD('A'));
  72.  
  73.                 (* Perform the palindromicity test.                 *)
  74.                 IS_PALINDROME := TRUE;
  75.                 I := 1;
  76.                 WHILE IS_PALINDROME AND (I <= LENGTH DIV 2) DO
  77.                 IF CHARS[I] = CHARS[LENGTH-I+1] THEN
  78.                     I := I + 1
  79.                 ELSE
  80.                     IS_PALINDROME := FALSE;
  81.             END (*WITH*);
  82.             (*****************  End of Palindrome (2)  **************)
  83.  
  84.  
  85.             IF IS_PALINDROME THEN
  86.             BEGIN
  87.                 (*****************  Palindrome (3)  *****************)
  88.                 (** Write IN_LINE to OUT_FILE.                     **)
  89.                 WITH IN_LINE DO
  90.                 BEGIN
  91.                     FOR J := 1 TO LENGTH DO
  92.                         WRITE (OUT_FILE, CHARS[J]);
  93.                 END (*WITH*);
  94.                 (*************  End of Palindrome (3)  **************)
  95.  
  96.                 WRITELN (OUT_FILE);
  97.             END (*IF*);
  98.         END (*WHILE*);
  99.         (*************  End of Palindrome (body)  *******************)
  100.  
  101.     END (*PALINDROME*).
  102.     (*******************  End of palindrome.pas  ********************)
  103.